BR 4

library(bayesrules)
library(tidyverse)

## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──

## ✓ ggplot2 3.3.5     ✓ purrr   0.3.4
## ✓ tibble  3.1.4     ✓ dplyr   1.0.7
## ✓ tidyr   1.1.3     ✓ stringr 1.4.0
## ✓ readr   2.0.1     ✓ forcats 0.5.1

## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()

Exercise 4.1

1. centering pi on 0.5
2. somewhat favoring pi>0.5
3. strongly favoring pi<0.5
4. somewhat favoring pi<0.5
5. strongly favoring pi>0.5

Exercise 4.2

E must have generated this plot. Since the prior is left skewed, we know alpha<beta, and since the likelihood is symmetrical, we know y/n=1/2. The only input sequence that fits this description is E.

Exercise 4.3

1. Beta(1, 5)
2. Beta(1, 1)
3. Beta(5, 1)
4. Beta(4, 3)
5. Beta(2, 4)

Exercise 4.4

1. Kimya’s prior is a downward sloping linear curve with a mode of 0, and a mean around 1/3.

plot_beta(1, 2)

2. Fernando’s model is highly left skewed, with a minimal amount of variation. It has a mean and mode close to 0.

plot_beta(0.5, 1)

3. Ciara’s model is also strongly left-skewed, but with a greater degree of variability. Her mean and mode are also higher (closer to 0.15).

plot_beta(3, 10)

4. Taylor’s model is right-skewed, with a low degree of variability. It has a mean and mode close to 1.

plot_beta(2, 0.1)

Exercise 4.5

1. Simulating the posterior model for Kimya.

set.seed(84735)
kimya_sim <- data.frame(pi = rbeta(10000, 1, 2)) %>% 
  mutate(y = rbinom(10000, size = 7, prob = pi))

Plotting simulation results

ggplot(kimya_sim, aes(x = pi, y = y)) + 
  geom_point(aes(color = (y == 3)), size = 0.1)

Filtering for only the data that matches our observed results

# Keep only the simulated pairs that match our data
kimya_posterior <- kimya_sim %>% 
  filter(y == 3)

# Plot the remaining pi values
ggplot(kimya_posterior, aes(x = pi)) + 
  geom_density()

Calculating mean pi value for y==3.

kimya_posterior %>% 
  summarize(mean(pi), sd(pi))

2. Simulating the posterior model for Fernando

set.seed(84735)
fernando_sim <- data.frame(pi = rbeta(10000, 0.5, 1)) %>% 
  mutate(y = rbinom(10000, size = 7, prob = pi))

Plotting simulation results

ggplot(fernando_sim, aes(x = pi, y = y)) + 
  geom_point(aes(color = (y == 3)), size = 0.1)

Filtering for only the data that matches our observed results

# Keep only the simulated pairs that match our data
fernando_posterior <- fernando_sim %>% 
  filter(y == 3)

# Plot the remaining pi values
ggplot(fernando_posterior, aes(x = pi)) + 
  geom_density()

Calculating mean pi value for y==3.

fernando_posterior %>% 
  summarize(mean(pi), sd(pi))

3. Simulating the posterior model for Ciara

set.seed(84735)
ciara_sim <- data.frame(pi = rbeta(10000, 3, 10)) %>% 
  mutate(y = rbinom(10000, size = 7, prob = pi))

Plotting simulation results

ggplot(ciara_sim, aes(x = pi, y = y)) + 
  geom_point(aes(color = (y == 3)), size = 0.1)

Filtering for only the data that matches our observed results

# Keep only the simulated pairs that match our data
ciara_posterior <- ciara_sim %>% 
  filter(y == 3)

# Plot the remaining pi values
ggplot(ciara_posterior, aes(x = pi)) + 
  geom_density()

Calculating mean pi value for y==3.

ciara_posterior %>% 
  summarize(mean(pi), sd(pi))

4. Simulating the posterior model for Taylor

set.seed(84735)
taylor_sim <- data.frame(pi = rbeta(10000, 2, 0.1)) %>% 
  mutate(y = rbinom(10000, size = 7, prob = pi))

Plotting simulation results

ggplot(taylor_sim, aes(x = pi, y = y)) + 
  geom_point(aes(color = (y == 3)), size = 0.1)

Filtering for only the data that matches our observed results

# Keep only the simulated pairs that match our data
taylor_posterior <- taylor_sim %>% 
  filter(y == 3)

# Plot the remaining pi values
ggplot(taylor_posterior, aes(x = pi)) + 
  geom_density()

Calculating mean pi value for y==3.

taylor_posterior %>% 
  summarize(mean(pi), sd(pi))

Exercise 4.6

1. Calculating Kimya’s posterior model

summarize_beta_binomial(1, 2, 3, 7)

Therefore, the posterior model is \[ Beta(4, 6)\]

The mean is slightly less in the exact calculation than in the simulation. The exact calculation yields a slightly lower variability (0.148) than the simulation (0.15).

2. Calculating Fernando’s posterior model

summarize_beta_binomial(0.5, 1, 3, 7)

Therefore, the posterior model is \[ Beta(3.5, 5)\]

The means are very similar in the simulation and the exact model. The exact calculation yields a slightly lower variability (0.1597) than the simulation (0.165).

3. Calculating Ciara’s posterior model

summarize_beta_binomial(3, 10, 3, 7)

Therefore, the posterior model is \[ Beta(6, 14)\]

The means in the simulation (0.29) is slight lower than the mean in the exact model (0.3). The exact calculation yields a slightly higher variability (0.01) than the simulation (0.0099). Overall, the simulation very closely approximates the exact model, however.

4. Calculating Taylor’s posterior model

summarize_beta_binomial(2, 0.1, 3, 7)

Therefore, the posterior model is \[ Beta(5, 4.1)\]

The means in the simulation (0.53) is slight lower than the mean in the exact model (0.55). The exact calculation yields a slightly lower variability (0.157) than the simulation (0.16).

Exercise 4.7

1. Potting the beta-binomial model

plot_beta_binomial(1, 4, 8, 10)

The data has more influence on the posterior, since the posterior model more closely resembles the likelihood curve. We can see this in that the posterior takes more after the likelihood curve in shape, mean and mode.

2. Potting the beta-binomial model

plot_beta_binomial(20, 3, 0, 1)

The prior has more influence on the posterior, since the posterior model more closely resembles the prior curve. We can see this in that the posterior takes more after the prior curve in shape, mean and mode.

3. Potting the beta-binomial model

plot_beta_binomial(4, 2, 1, 3)

The prior has slightly more influence on the posterior, since the posterior model bears a slightly stronger resemblance to the prior curve. We can see this in that the posterior takes more after the prior curve in shape, though its mean and mode lay fairly equally between the likelihood and the prior.

4. Potting the beta-binomial model

plot_beta_binomial(3, 10, 10, 13)

The posterior is an equal compromise between the data and the prior. We can see this in that the posterior bears an equal resemblance to the prior and likelihood curves.

5. Potting the beta-binomial model

plot_beta_binomial(20, 2, 10, 200)

The data has more influence on the posterior, since the posterior model more closely resembles the likelihood curve. We can see this in that the posterior takes more after the likelihood curve in shape, mean and mode.

Exercise 4.8

I did this as a means to answer 4.7.

Exercise 4.9

1. Beta(7, 2) is a right-skewed model, so some reasonable values for pi would be between 0.7 and 0.9.

2. I would shift the average value of pi even higher, closer to 1. This would increase my estimated mean value, and decrease the amount of variability relative to that hypothesized in the Beta(7, 2) model.

3. I would shift the average value of pi much lower, closer to 0. My estimated mean value would now fall within 0.2-0.4. This data would also slightly reduce the amount of variability relative to that hypothesized in the Beta(7, 2) model.

4. I would shift the average value of pi closer to 0.5. This data would also slightly decrease the amount of variability relative to that hypothesized in the Beta(7, 2) model.

Exercise 4.10

1. We will use the following equation to solve for n and y: \[ \pi | (Y=y) = Beta(\alpha + y, \beta +n - y)\]

#prior alpha and beta
a <- 0.5
b <- 0.5

#posterior alpha and beta
a_1 <- 8.5
b_1 <- 2.5

y <- a_1 - a
n <- b_1-b+y
y

## [1] 8

n

## [1] 10

Plotting the prior, likelihood and posterior models:

plot_beta_binomial(0.5, 0.5, 8, 10)

2. We’ll use the same equation as in part A.

#prior alpha and beta
a <- 0.5
b <- 0.5

#posterior alpha and beta
a_1 <- 3.5
b_1 <- 10.5

y <- a_1 - a
n <- b_1-b+y
y

## [1] 3

n

## [1] 13

Plotting the prior, likelihood and posterior models:

plot_beta_binomial(0.5, 0.5, 3, 13)

3. We’ll use the same equation as in part A.

#prior alpha and beta
a <- 10
b <- 1

#posterior alpha and beta
a_1 <- 12
b_1 <- 15

y <- a_1 - a
n <- b_1-b+y
y

## [1] 2

n

## [1] 16

Plotting the prior, likelihood and posterior models:

plot_beta_binomial(10, 1, 2, 16)

4. We’ll use the same equation as in part A.

#prior alpha and beta
a <- 8
b <- 3

#posterior alpha and beta
a_1 <- 15
b_1 <- 6

y <- a_1 - a
n <- b_1-b+y
y

## [1] 7

n

## [1] 10

Plotting the prior, likelihood and posterior models:

plot_beta_binomial(8, 3, 7, 10)

5. We’ll use the same equation as in part A.

#prior alpha and beta
a <- 2
b <- 2

#posterior alpha and beta
a_1 <- 5
b_1 <- 5

y <- a_1 - a
n <- b_1-b+y
y

## [1] 3

n

## [1] 6

Plotting the prior, likelihood and posterior models:

plot_beta_binomial(2, 2, 3, 6)

6. We’ll use the same equation as in part A.

#prior alpha and beta
a <- 1
b <- 1

#posterior alpha and beta
a_1 <- 30
b_1 <- 3

y <- a_1 - a
n <- b_1-b+y
y

## [1] 29

n

## [1] 31

Plotting the prior, likelihood and posterior models:

plot_beta_binomial(1, 1, 29, 31)

Exercise 4.11

1. We will use the summarize_beta_binomial function to identify the posterior model

summarize_beta_binomial(1, 1, 10, 13)

Therefore, the posterior model is \[Beta(11, 4)\] Now we will plot the prior, likelihood and posterior curves:

plot_beta_binomial(1,1, 10, 13)

2. We will use the summarize_beta_binomial function to identify the posterior model

summarize_beta_binomial(1, 1, 0, 1)

Therefore, the posterior model is \[Beta(1, 2)\] Now we will plot the prior, likelihood and posterior curves:

plot_beta_binomial(1,1, 0, 1)

3. We will use the summarize_beta_binomial function to identify the posterior model

summarize_beta_binomial(1, 1, 100, 130)

Therefore, the posterior model is \[Beta(101, 31)\] Now we will plot the prior, likelihood and posterior curves:

plot_beta_binomial(1,1, 100, 130)

4. We will use the summarize_beta_binomial function to identify the posterior model

summarize_beta_binomial(1, 1, 20, 120)

Therefore, the posterior model is \[Beta(21, 101)\] Now we will plot the prior, likelihood and posterior curves:

plot_beta_binomial(1,1, 20, 120)

5. We will use the summarize_beta_binomial function to identify the posterior model

summarize_beta_binomial(1, 1, 234, 468)

Therefore, the posterior model is \[Beta(235, 235)\] Now we will plot the prior, likelihood and posterior curves:

plot_beta_binomial(1,1, 234, 468)

Exercise 4.12

1. We will use the summarize_beta_binomial function to identify the posterior model

summarize_beta_binomial(10, 2, 10, 13)

Therefore, the posterior model is \[Beta(11, 4)\] Now we will plot the prior, likelihood and posterior curves:

plot_beta_binomial(10, 2, 20, 5)

## Warning in (function (x, shape1, shape2, ncp = 0, log = FALSE) : NaNs produced

## Warning in (function (x, shape1, shape2, ncp = 0, log = FALSE) : NaNs produced

## Warning: Removed 101 row(s) containing missing values (geom_path).

## Warning in max(ids, na.rm = TRUE): no non-missing arguments to max; returning
## -Inf

## Warning: Removed 101 row(s) containing missing values (geom_path).

## Warning in max(ids, na.rm = TRUE): no non-missing arguments to max; returning
## -Inf

2. We will use the summarize_beta_binomial function to identify the posterior model

summarize_beta_binomial(10, 2, 0, 1)

Therefore, the posterior model is \[Beta(1, 2)\] Now we will plot the prior, likelihood and posterior curves:

plot_beta_binomial(10,2, 10, 3)

## Warning in (function (x, shape1, shape2, ncp = 0, log = FALSE) : NaNs produced

## Warning in (function (x, shape1, shape2, ncp = 0, log = FALSE) : NaNs produced

## Warning: Removed 101 row(s) containing missing values (geom_path).

## Warning in max(ids, na.rm = TRUE): no non-missing arguments to max; returning
## -Inf

## Warning: Removed 101 row(s) containing missing values (geom_path).

## Warning in max(ids, na.rm = TRUE): no non-missing arguments to max; returning
## -Inf

3. We will use the summarize_beta_binomial function to identify the posterior model

summarize_beta_binomial(10, 2, 100, 130)

Therefore, the posterior model is \[Beta(101, 32)\] Now we will plot the prior, likelihood and posterior curves:

plot_beta_binomial(10,2, 100, 130)

4. We will use the summarize_beta_binomial function to identify the posterior model

summarize_beta_binomial(10, 2, 20, 120)

Therefore, the posterior model is \[Beta(30, 102)\] Now we will plot the prior, likelihood and posterior curves:

plot_beta_binomial(10,2, 20, 120)

5. We will use the summarize_beta_binomial function to identify the posterior model

summarize_beta_binomial(10, 2, 234, 468)

Therefore, the posterior model is \[Beta(244, 236)\] Now we will plot the prior, likelihood and posterior curves:

plot_beta_binomial(10,2, 234, 468)

Exercise 4.13

1. Below is my sketch of the prior pdf.

caption

2. The politician’s prior understanding of pi is that the probability of seeing a mean greater than 0.5 is 2, and the probability of seeing a mean less than 0.5 is 0. This doesn’t really make sense to me…why is he restricting his probability of success to greater than 0.5 from the outset?

3. We can construct the posterior pdf can be found by reference to the likelihood and prior values. Note: the posterior f(pi|y=0)=0 for pi<0.5. However, for pi>0.5, we have the following model:

\[f(\pi|y=0) = f(\pi)*L(\pi|y=0)\] Plugging into this formula, we have:

\[f(\pi|y=0) = 2*C(0, 100)*\pi^{0}*(1-\pi)^{100}\] Below is my sketch of the posterior pdf:

4. The politician’s posterior understanding reflects low and declining probabilities for 0.5<pi<1. This more accurately reflects the observed data, and thus merges the prior model and the likelihood function. The politician made a mistake in assuming the probability of an average approval rating below 50% (pi<0.5) was zero. This is reflected in the declining trend towards 0 of f(pi) as we approach 1. This means that the politician’s approval rating was much lower than he hypothesized.

Exercise 4.14

1. Proof of equivalence:

2. As n increases, the posterior mode approaches zero. If we fix alpha, beta and y to equal 1, and allow n to vary from 1 to 10 to 100, we can see this trend:

a <- 1
b <- 1
y <- 1
n_0 <- 1
n_1 <- 10
n_2 <- 100


posterior_mode1 <- (a+y-1)/(a+b+n_0-2)
posterior_mode1

## [1] 1

posterior_mode2 <- (a+y-1)/(a+b+n_1-2)
posterior_mode2

## [1] 0.1

posterior_mode3 <- (a+y-1)/(a+b+n_2-2)
posterior_mode3

## [1] 0.01

Exercise 4.15

1. Since we observed 1 success and 0 failures, we add one to alpha and 0 to beta, producing the following posterior model: \[ Beta(3, 3)\]

2. Since we observed 1 more success and 0 failures, we add one to alpha and 0 to beta, producing the following posterior model: \[ Beta(4, 3)\]

3. Since we observed 0 more successes and 1 more failure, we add zero to alpha and 1 to beta, producing the following posterior model: \[ Beta(4, 4)\]

4. Since we observed 1 more success and 0 more failures, we add one to alpha and 0 to beta, producing the following posterior model: \[ Beta(5, 4)\] ## Exercise 4.16

5. Since we observed 3 more successes and 2 more failures, we add 3 to alpha and 2 to beta, producing the following posterior model: \[ Beta(5, 5)\]

6. Since we observed 1 success and 4 more failures, we add 1 to alpha and 4 to beta, producing the following posterior model: \[ Beta(6, 9)\]

7. Since we observed 1 success and 4 more failures, we add 1 to alpha and 4 to beta, producing the following posterior model: \[ Beta(7, 13)\]

8. Since we observed 2 successes and 3 more failures, we add 2 to alpha and 3 to beta, producing the following posterior model: \[ Beta(9, 16)\]

Exercise 4.17

1. Plotting the prior model:

plot_beta(4, 3)

The employees believe that an average of around 60% of people will click on the ad, with a moderate level of variance.

2. Constructing the posterior models:

For the first employee, with a sample size of one, and 0 successes and one failure, we can add 0 to alpha and 1 to beta, producing the following posterior model: \[ Beta(4, 4)\]

For the second employee, with a sample size of 10, and 3 successes and 7 failures, we can add 3 to alpha and 7 to beta, producing the following posterior model: \[ Beta(7, 10)\] For the third employee, with a sample size of 100, and 20 successes and 80 failures, we can add 20 to alpha and 80 to beta, producing the following posterior model: \[ Beta(24, 83)\] c. Plotting the prior, likelihood and posterior for the first employee:

plot_beta_binomial(4, 3, 0, 1)

Plotting the prior, likelihood and posterior for the second employee:

plot_beta_binomial(4, 3, 3, 10)

Plotting the prior, likelihood and posterior for the third employee:

plot_beta_binomial(4, 3, 20, 100)

4. The first employee’s posterior is almost exactly symmetrical, with a mean around 0.5 and a moderate level of variance. The second employee’s posterior is still highly symmetrical, but with a slightly lower mean (close to 0.4), and a lower level of variance. The third employee’s posterior is significantly lower (close to 0.2), with an even smaller level of variance (most values ranging from 0.125 to 0.375).

Exercise 4.18

uniform_Plot <- function(a, b){
  xvals <- data.frame(x = c(a, b)) #Range for x-values
  
  ggplot(data.frame(x = xvals), aes(x = x)) + xlim(c(a, b)) + ylim(0, 1/(b - a)) +
    stat_function(fun = dunif, args = list(min = a, max = b), geom = "area", 
                  fill = "green", alpha = 0.35) + 
    stat_function(fun = dunif, args = list(min = a, max = b)) +
    labs(x = "\n u", y = "f(u) \n", 
         title = paste0("Uniform Distribution \n With Min = ", a, " & Max = ", b, " \n")) +
    theme(plot.title = element_text(hjust = 0.5),
          axis.title.x = element_text(face="bold", colour="blue", size = 12),
          axis.title.y = element_text(face="bold", colour="blue", size = 12)) +
    geom_vline(xintercept = a, linetype = "dashed", colour = "red") +
    geom_vline(xintercept = b, linetype = "dashed", colour = "red")
  
}

uniform_Plot(a = 0.5, b = 1)